home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #46 (Jul 89) / Basic Source / Main Program.BAS < prev    next >
BASIC Source File  |  1989-05-19  |  8KB  |  259 lines
  1. ' This program contains 3 new subroutines which
  2. ' may be used with the ZBasic Program Generator.
  3. ' ©1989 MacTutor
  4. ' Subroutines by Charles Stricklin, modified by Dave Kelly
  5. '************************************************************
  6. '                      • CONFIGURATION • 
  7. '************************************************************
  8. '
  9. '            Default Variable Type:Integer
  10. '            Convert to Upper Case:Yes
  11. '        Space Req.After Key Words:Yes
  12. '                     Array Base 1:No
  13. '                       Bundle Bit:Yes
  14. '
  15. '************************************************************
  16. '                    • SET UP VARIABLES • 
  17. '************************************************************
  18. WINDOW OFF:COORDINATE WINDOW:DEF MOUSE=-1:WIDTH -2
  19. DIM T,L,B,R,MY,MX'                REQUIRED FOR TOOL BOX CALLS
  20. '------------------------------------------------------------
  21. WND=1:GOSUB"BUILD WINDOW"
  22. GOSUB "BUILD MENU"
  23. GOTO"EVENT QUEUE"
  24. '************************************************************
  25. '                        • THE QUEUE • 
  26. '************************************************************
  27. "EVENT QUEUE"
  28. ON DIALOG GOSUB "HANDLE DIALOG":DIALOG ON
  29. ON BREAK  GOSUB "HANDLE BREAK" :BREAK  ON
  30. ON MOUSE  GOSUB "HANDLE MOUSE" :MOUSE  ON
  31. ON MENU         GOSUB "Handle Menu" :MENU ON
  32. :
  33. "LOOP"
  34. GOTO"LOOP"
  35. :
  36. DIALOG OFF:BREAK OFF:MOUSE OFF
  37. '************************************************************
  38. '                     • DIALOG ROUTINES • 
  39. '************************************************************
  40. "HANDLE DIALOG"
  41. :
  42. ACT=DIALOG(0):REF=DIALOG(ACT)
  43. :
  44. IF ACT=3 THEN WINDOW REF:RETURN
  45. IF ACT=4 THEN GOSUB"CAPTURE":WINDOW CLOSE REF:END
  46. IF ACT=5 THEN "FORMAT WINDOW"
  47. IF ACT=11 THEN EDIT FIELD REF,""
  48. :
  49. LONG IF WINDOW(0)=1
  50. END IF
  51. :
  52. RETURN
  53. '************************************************************
  54. '                      • BREAK ROUTINE • 
  55. '************************************************************
  56. "HANDLE BREAK"
  57. END
  58. '************************************************************
  59. '                     • MOUSE ROUTINES • 
  60. '************************************************************
  61. "HANDLE MOUSE"
  62. :
  63. MACT=MOUSE(0):MX=MOUSE(1):MY=MOUSE(2)
  64. :
  65. RETURN
  66. "Handle Menu"
  67. MenuNumber=MENU(0)
  68. Menuitem=MENU(1)
  69. MENU
  70. IF MenuNumber=1 AND Menuitem=12 THEN END
  71. RETURN
  72.  
  73. 'GETINDSTRING$ function By Charles Stricklin
  74. 'Modified by Dave Kelly for MacTutor, May, 1989
  75.  
  76. 'This function is identical to the procedure GetIndString
  77. 'which is not in ROM and not supported by ZBasic.  It reads
  78. 'a string from a string list and returns a copy of it in the
  79. 'variable the String$.  If the string list doesn't exist of the
  80. 'index is out of range an empty string is returned.
  81.  
  82. ' stringListID is the resource ID of the string list; it's resource type is 'STR#'.
  83. ' stringIndex is the index of the desired string within the list.
  84.  
  85. LONG FN GETINDSTRING$(StringListID, StringIndex)
  86.     TheString$=""
  87.     Offset=0
  88.     FALSE=0
  89.     MyHandle&=FN GETRESOURCE(CVI("STR#"),StringListID)
  90.     LONG IF FN RESERROR=FALSE
  91.         MyPointer&=USR 3(MyHandle&)
  92.         NumberOfStrings=PEEK WORD(MyPointer&)
  93.         LONG IF (StringIndex>0) AND (StringIndex <= NumberOfStrings)
  94.             LONG IF StringIndex>1
  95.                 FOR ThisString=1 TO StringIndex-1
  96.                     LengthOfThisString=PEEK(MyPointer&+2+Offset)
  97.                     Offset=Offset+LengthOfThisString+1
  98.                 NEXT
  99.             END IF
  100.             LengthOfDesiredString=PEEK(MyPointer&+2+Offset)
  101.             FOR Character=1 TO LengthOfDesiredString
  102.                 TheString$=TheString$+CHR$(PEEK(MyPointer&+2+Offset+Character))
  103.             NEXT
  104.         END IF
  105.     MyHandle&=USR 7(MyPointer&)
  106.     CALL DETACHRESOURCE(MyHandle&)
  107.     END IF
  108. END FN= TheString$
  109.  
  110. 'GETRESMENU function By Charles Stricklin
  111. 'Modified by Dave Kelly for MacTutor, May, 1989
  112.  
  113. 'This function creates a ZBasic menu from a MENU resource.
  114. 'The result given is boolean; true if the task is accomplished,
  115. 'false if there's a problem (i.e. the resource doesn't exist, etc.)
  116.  
  117. ' resourceID is the resource ID of the menu resource to be used.
  118. '  menuNumber is the ZBasic number of the menu to be created.
  119.  
  120. LONG FN GETRESMENU(ResourceID, MenuNumber)
  121.     DEFSTR LONG
  122.     Done=0
  123.     FALSE=0
  124.     MenuBlkSize=14
  125.     Title$=""
  126.     MyHandle&=FN GETRESOURCE(CVI("MENU"),ResourceID)
  127.     LONG IF FN RESERROR=FALSE
  128.         MyPointer&=USR 3(MyHandle&)
  129.         EnableFlags&=PEEK LONG(MyPointer&+10)
  130.         State=VAL(MID$(BIN$(EnableFlags&),32,1))
  131.         LengthTitle=PEEK(MyPointer&+MenuBlkSize)
  132.         FOR Character=1 TO LengthTitle
  133.             Title$=Title$+CHR$(PEEK(MyPointer&+MenuBlkSize+Character))
  134.         NEXT
  135.         MENU MenuNumber,0,State,Title$
  136.         Offset&=MenuBlkSize+LengthTitle+1
  137.         DO
  138.             MenuItem=MenuItem+1:Title$=""
  139.             LengthTitle=PEEK(MyPointer&+Offset&)
  140.             FOR Character=1 TO LengthTitle
  141.                 Title$=Title$+CHR$(PEEK(MyPointer&+Offset&+Character))
  142.             NEXT
  143.             Offset&=Offset&+LengthTitle+1
  144.             IconNumber&=PEEK(MyPointer&+Offset&)
  145.             IF IconNumber& THEN Title$=Title$+"^"+RIGHT$(STR$(IconNumber&),1)
  146.             CommandKey=PEEK(MyPointer&+Offset&+1)
  147.             IF CommandKey THEN Title$=Title$+"/"+CHR$(CommandKey)
  148.             MarkChar = PEEK(MyPointer&+Offset&+2)
  149.             IF MarkChar THEN Title$=Title$+"!"+CHR$(MarkChar)
  150.             CharacterStyle=PEEK(MyPointer&+Offset&+3)
  151.             IF FN BITTST(CharacterStyle,0) THEN Title$=Title$+"<B"
  152.             IF FN BITTST(CharacterStyle,1) THEN Title$=Title$+"<I"
  153.             IF FN BITTST(CharacterStyle,2) THEN Title$=Title$+"<U"
  154.             IF FN BITTST(CharacterStyle,3) THEN Title$=Title$+"<O"
  155.             IF FN BITTST(CharacterStyle,4) THEN Title$=Title$+"<S"
  156.          State=VAL(MID$(BIN$(EnableFlags&),32-MenuItem,1))
  157.             Offset&=Offset&+4
  158.             MENU MenuNumber, MenuItem, State, Title$
  159.     UNTIL PEEK(MyPointer&+Offset&)=FALSE
  160.     Done=-1
  161.     END IF
  162.     MyHandle&=USR 7(MyPointer&)
  163.     CALL DETACHRESOURCE(MyHandle&)
  164. END FN=Done
  165.  
  166. 'GETRESWINDOW function By Charles Stricklin
  167. 'Modified by Dave Kelly for MacTutor, May, 1989
  168.  
  169. 'This function creates a ZBasic window from a window template
  170. 'resource.  The result given is boolean;true if task is accomplished,
  171. 'false if there's a problem (i.e. resource doesn't exist, etc.)
  172.  
  173. ' resourceID is the resource ID of the window template to be used.
  174. ' windowNumber is the ZBasic number of the window to be created.
  175. ' modal is boolean.
  176.  
  177. LONG FN GETRESWINDOW(ResourceID, WindowNumber, Modal)
  178.     Done=0
  179.     Title$=""
  180.     FALSE=0
  181.     MyHandle&=FN GETRESOURCE(CVI("WIND"),ResourceID)
  182.     LONG IF FN RESERROR=FALSE
  183.         MyPointer&=USR 3(MyHandle&)
  184.         Y1=PEEK WORD(MyPointer&)
  185.         X1=PEEK WORD(MyPointer&+2)
  186.         Y2=PEEK WORD(MyPointer&+4)
  187.         X2=PEEK WORD(MyPointer&+6)
  188.         Type=PEEK WORD(MyPointer&+8)+1
  189.         HasClose=PEEK WORD(MyPointer&+12)
  190.         LengthOfTitle=PEEK(MyPointer&+18)
  191.         FOR Character=1 TO LengthOfTitle
  192.             Title$=Title$+CHR$(PEEK(MyPointer&+18+Character))
  193.         NEXT
  194.         IF Type=13 THEN Type=9: 'ZBasic doesn't support ZoomNoGrow
  195.         IF HasClose=FALSE THEN Type=Type+256
  196.         IF Modal THEN Type=-Type
  197.         WINDOW WindowNumber,Title$,(X1,Y1)-(X2,Y2),Type
  198.         Done=-1
  199.     END IF
  200.     MyHandle&=USR 7(MyPointer&)
  201.     CALL DETACHRESOURCE(MyHandle&)
  202. END FN=Done
  203.  
  204. '************************************************************
  205. '                     • WINDOW ROUTINES • 
  206. '************************************************************
  207. "BUILD WINDOW"
  208. IF WND=1 THEN Result=FN GETRESWINDOW(1,1,0)
  209. GOSUB"BUILD EDITS":GOSUB"FILL EDITS":GOSUB "FORMAT WINDOW"
  210. RETURN
  211. '************************************************************
  212. '                     • MENU ROUTINES • 
  213. '************************************************************
  214. "BUILD MENU"
  215. Result=FN GETRESMENU(1002,1)
  216. RETURN
  217. '************************************************************
  218. '              • PUT GRAPHICS & TEXT IN WINDOW • 
  219. '************************************************************
  220. "FORMAT WINDOW"
  221. CALL PENNORMAL
  222. :
  223. LONG IF WINDOW(0)=1
  224. PrintString$=FN GETINDSTRING$(31618, 1)
  225. LOCATE 1,1:PRINT PrintString$
  226. PrintString$=FN GETINDSTRING$(31618, 2)
  227. LOCATE 4,2:PRINT PrintString$
  228. END IF
  229. :
  230. CALL PENNORMAL:RETURN
  231. '************************************************************
  232. '             • CREATE EDIT FIELDS AND BUTTONS • 
  233. '************************************************************
  234. "BUILD EDITS"
  235. TEXT ,,0,0
  236. :
  237. LONG IF WINDOW(0)=1
  238. END IF
  239. :
  240. RETURN
  241. '************************************************************
  242. '            • FILL EDIT FIELDS AND SET BUTTONS • 
  243. '************************************************************
  244. "FILL EDITS"
  245. :
  246. LONG IF WINDOW(0)=1
  247. END IF
  248. :
  249. RETURN
  250. '************************************************************
  251. '        • CAPTURE EDIT FIELD STRINGS & READ BUTTONS • 
  252. '************************************************************
  253. "CAPTURE"
  254. :
  255. LONG IF WINDOW(0)=1
  256. END IF
  257. :
  258. RETURN
  259.